home *** CD-ROM | disk | FTP | other *** search
/ ftp.alaska-software.com / 2014.06.ftp.alaska-software.com.tar / ftp.alaska-software.com / 3pp / mxsetup.old / {app} / Regclass.prg < prev    next >
Text File  |  2001-08-08  |  25KB  |  904 lines
  1. /*
  2.  
  3.    Registry-Klassenbibliothek fⁿr Xbase++
  4. =======================================================
  5.    Registry class for Xbase++
  6.  
  7. (C) Thomas Braun Softwareentwicklung
  8.     Hindenburgstr. 69
  9.     D-72336 Balingen
  10.     GERMANY
  11.  
  12.     e-mail   : braunt@compuserve.com
  13.     Homepage : http://www.software-braun.de
  14.  
  15. Feel free to use the source below in any project you
  16. like as long as you keep the above copyright note.
  17.  
  18. The most current version of this class can be found on
  19. my homepage.
  20.  
  21. Any comments and enhancements are always welcome.
  22.  
  23. If you have any questions regarding this source feel free
  24. to contact me via e-mail.
  25.  
  26. ---------------------------------------------------------------------------------------
  27. CHANGE HISTORY (sorry german guys, only in english ;-) :
  28.  
  29. 29.08.1999 Fixed a weird "duplicate variable declaration" error with Xbase++ SL2 1.20.204
  30.  
  31. 21.08.1999 removed a left over "Return lSuccess" in xbpReg:DelKey()
  32.            Fixed bug in :Init() method with SET EXACT ON. Init is now saving
  33.            the current EXACT-state and restoring it when finished. (Thanks to
  34.            Ken Levitt for this)
  35.  
  36.  
  37. 18.04.1999 Added Section "CHANGE HISTORY"
  38.            New iVar cReadBinaryTypeAs
  39.            New ACCESS/ASSIGN ReadBinType
  40.            New Method ::ValueList() for retrieving a 2-dim array that contains all
  41.                                     value names - value pairs. (so now you can query if
  42.                                     a value already exists)
  43.            several minor bugfixes regarding the useage under WindowsNT
  44.            (thanks to Axel Zimelka for this one and Johan Droskie for some
  45.             other comments)
  46.  
  47. */
  48.  
  49.  
  50. #include "common.ch"
  51. #include "dll.ch"
  52. #include "regclass.ch"
  53. #include "set.ch"
  54.  
  55.  
  56. /*
  57.  Registry Klasse, verwaltet Informationen und stellt Zugriffsfunktionen fⁿr einen
  58.  bestimmten RegistryKey bereit. Dieser mu▀ in der Init-Funktion angegeben werden.
  59.  
  60.  Die Manipulationsmethoden erlauben es dann, Werte und weitere Key┤s hinzu-
  61.  zufⁿgen / zu l÷schen / abzufragen usw.
  62.  =================================================================================
  63.  Registry class, contains information and accessfunctions for a single
  64.  registry key. The name of the key must be set with the init method.
  65.  
  66.  The manipulation methods then allow to add/delete keys and values
  67.  
  68. */
  69. CLASS XbpReg
  70.  
  71.    HIDDEN:
  72.       METHOD RegOpenKeyEx, RegCreateKeyEx, RegQueryInfoKey, RegCloseKey
  73.       METHOD RegEnumKeyEx, RegEnumValue
  74.       VAR nHKey                     // numerical handle from regclass.ch for the root key
  75.       VAR cKey                      // Name of Subkey to open
  76.       VAR nKeyHandle                // Handle to currently open key
  77.       VAR lStatus                   // State of Key┤s (see comment in the init method)
  78.       VAR nCallSuccess              // return value of all Reg...DLL functions
  79.       VAR nDllHandle                // DLL handle
  80.       VAR xValue                    // general purpose iVar
  81.       VAR cClass
  82.       VAR nClass
  83.       VAR nSubKeys
  84.       VAR nMaxSubKeyLen
  85.       VAR nMaxClassLen
  86.       VAR nValues
  87.       VAR nMaxValueNameLen
  88.       VAR nMaxValueLen
  89.       VAR nSecurityDescriptor
  90.       VAR cLastWriteTime
  91.       VAR nLastWriteTime
  92.       VAR cReadBinaryTypeAs
  93.  
  94.    EXPORTED:
  95.       METHOD Init, Create
  96.       METHOD NewKey, DelKey
  97.       METHOD GetValue, SetValue, DelValue
  98.       METHOD KeyList, MoveUp, MoveDown
  99.       METHOD ValueList
  100.  
  101.       ACCESS ASSIGN METHOD Standard
  102.       ACCESS ASSIGN METHOD ReadBinType     // get/set ::cReadBinaryTypeAs
  103.       ACCESS METHOD Status
  104.       ACCESS METHOD KeyName
  105.  
  106. ENDCLASS
  107.  
  108. /*
  109.    Init-Methode. Ermitteln, welcher Root-Key ben÷tigt wird und diesen in ::nHKey
  110.    eintragen.
  111.  
  112.    Subkey ermitteln und diesen in ::cKey eintragen
  113.  
  114.    Die Memberfunktion ::Status() gibt einen logischen Wert zurⁿck der angibt,
  115.    ob der Key bereits in der Registry angelegt ist (.T.) oder nicht (.F.)
  116.  
  117.    Wird lCreate auf .T. (default = .F.) gesetzt und existiert der Key noch nicht,
  118.    so wird er neu angelegt. Anderenfalls mu▀ er mittels der Methode ::create()
  119.    erzeugt werden.
  120.  
  121. =======================================================================================
  122.  
  123.    Init method. First determine the needed root key which is then stored in ::nHKey
  124.  
  125.    Determine subkey name and store into ::cKey
  126.  
  127.    The member function ::Status() returns a logical value that states if the key already
  128.    exists in the registry (.T.) or not (.F.)
  129.  
  130.    If lCreate is set to .T. (default = .F.) and the key does not exist, it is
  131.    created in the init method.
  132.  
  133.    Otherwise it has to be created via the :create() method.
  134.  
  135. */
  136. METHOD XbpReg:Init( cRegKey, lCreate, lReInit )
  137.    LOCAL nPos := 0
  138.    /*
  139.       Turning EXACT off, otherwise some string compares will fail...
  140.       ======================
  141.       EXACT auf "OFF" schalten, weil sonst einige String-Vergleiche weiter
  142.       unten scheitern...
  143.    */
  144.    LOCAL lSetExact := SET( _SET_EXACT , .F. )
  145.  
  146.    DEFAULT cRegKey TO ""
  147.    DEFAULT lCreate TO .F.
  148.    DEFAULT lReInit TO .F.
  149.  
  150.    ::lStatus             := .F.
  151.    ::nDllHandle          := 0
  152.    ::cClass              := ""
  153.    ::nClass              := 0
  154.    ::nSubKeys            := 0
  155.    ::nMaxSubKeyLen       := 0
  156.    ::nMaxClassLen        := 0
  157.    ::nValues             := 0
  158.    ::nMaxValueNameLen    := 0
  159.    ::nMaxValueLen        := 0
  160.    ::nSecurityDescriptor := 0
  161.    ::cLastWriteTime      := ""
  162.    ::nLastWriteTime      := 0
  163.  
  164.    // Keep setting when doing :MoveUp / :MoveDown
  165.    If ! lReInit
  166.       ::cReadBinaryTypeAs   := "A"                  // Read Binary data into an array
  167.    EndIF
  168.  
  169.    If ! EMPTY( cRegKey )
  170.       If cRegKey = "\"                           // remove backslash
  171.          cRegKey := SUBSTR( cRegKey, 2 )
  172.       EndIF
  173.  
  174.       nPos := AT( "\", cRegKey )                 // det. name of subkey
  175.  
  176.       DO CASE
  177.          CASE cRegKey = "HKEY_LOCAL_MACHINE"
  178.             ::nHKey := HKEY_LOCAL_MACHINE
  179.  
  180.          CASE cRegKey = "HKEY_CLASSES_ROOT"
  181.             ::nHKey := HKEY_CLASSES_ROOT
  182.  
  183.          CASE cRegKey = "HKEY_USERS"
  184.             ::nHKey := HKEY_USERS
  185.  
  186.          CASE cRegKey = "HKEY_CURRENT_USER"
  187.             ::nHKey := HKEY_CURRENT_USER
  188.  
  189.          OTHERWISE
  190.             ::nHKey := HKEY_NO_KEY
  191.  
  192.       ENDCASE
  193.  
  194.       If ::nHKey # HKEY_NO_KEY                   // if root key exists
  195.  
  196.          If nPos # 0
  197.             ::cKey := SUBSTR( cRegKey, nPos + 1 )
  198.          Else
  199.             ::cKey := ""
  200.          ENDIF
  201.  
  202.          ::RegOpenKeyEx( ::cKey )                // open key
  203.  
  204.          If ::nCallSuccess = ERROR_SUCCESS
  205.             ::lStatus := .T.
  206.          ELSE
  207.             If lCreate
  208.                ::RegCreateKeyEx( ::cKey )
  209.                IF ::nCallSuccess = ERROR_SUCCESS
  210.                   ::lStatus := .T.
  211.                EndIF
  212.             EndIF
  213.          EndIF
  214.  
  215.          ::RegCloseKey()
  216.  
  217.       EndIF
  218.    EndIF
  219.  
  220.    SET( _SET_EXACT , lSetExact )
  221.  
  222. RETURN self
  223.  
  224. /*
  225.  
  226.    Registry Key erzeugen, hat nur eine Bedeutung, wenn der Key noch nicht existiert
  227.    d.H. ::Status() == .F.
  228.  
  229.    Create mu▀ nicht aufgerufen werden, wenn der Key existiert oder die init Methode
  230.    mit lCreate == .T. aufgerufen wurde.
  231.  
  232. ===================================
  233.  
  234.    Create registry key. Only works if the key does not exist (::Status() = .F.)
  235.  
  236.    Create is not needed if the Key exists or you call the init method with
  237.    lCreate == .T.
  238.  
  239. */
  240. METHOD XbpReg:Create
  241.  
  242.    If ::lStatus == .F.  .AND. ::nHKey # HKEY_NO_KEY
  243.  
  244.       ::RegOpenKeyEx( ::cKey )               // open registry key
  245.  
  246.       If ::nCallSuccess = ERROR_SUCCESS
  247.          ::lStatus := .T.
  248.       ELSE
  249.          ::RegCreateKeyEx( ::cKey )
  250.          IF ::nCallSuccess = ERROR_SUCCESS
  251.             ::lStatus := .T.
  252.          EndIF
  253.       EndIF
  254.  
  255.       ::RegCloseKey()                        // close registry key
  256.  
  257.    EndIF
  258.  
  259. RETURN self
  260.  
  261. /*
  262.    Registry Key ÷ffnen
  263.  
  264. ================================
  265.  
  266.    Open registry key
  267.  
  268. */
  269. METHOD XbpReg:RegOpenKeyEx( cSubKey )
  270.    LOCAL nNewKeyHandle := 0
  271.  
  272.    ::nCallSuccess := 1  // 1 = no success; 0 = success
  273.    If ::nDllHandle = 0
  274.       ::nDllHandle := DllLoad( "ADVAPI32.DLL" )
  275.    EndIF
  276.  
  277.    If ::nhKey # HKEY_NO_KEY
  278.       ::nCallSuccess := DllCall( ::nDllHandle, DLL_STDCALL, "RegOpenKeyExA", ::nhKey,;
  279.                                cSubKey, 0, KEY_ALL_ACCESS , @nNewKeyHandle )
  280.  
  281.       If ::nCallSuccess = ERROR_SUCCESS
  282.          ::nKeyHandle := nNewKeyHandle
  283.          ::RegQueryInfoKey()
  284.       EndIF
  285.  
  286.    EndIF
  287.  
  288. RETURN ::nCallSuccess
  289.  
  290. /*
  291.    Registry-Schlⁿssel schlie▀en
  292.  
  293. =======================================
  294.  
  295.    Close registry key
  296.  
  297. */
  298. METHOD XbpReg:RegCloseKey
  299.  
  300.    If ::nDllHandle = 0
  301.       ::nDllHandle := DllLoad( "ADVAPI32.DLL" )
  302.    EndIF
  303.  
  304.    ::nCallSuccess := DllCall( ::nDllHandle, DLL_STDCALL, "RegCloseKey", ::nKeyHandle )
  305.    If ::nCallSuccess = ERROR_SUCCESS
  306.       ::nKeyHandle := HKEY_NO_KEY
  307.    EndIF
  308.  
  309.    If ::nDllHandle # 0
  310.       DllUnload( ::nDllHandle )
  311.       ::nDllHandle := 0
  312.    EndIF
  313.  
  314. RETURN ::nCallSuccess
  315.  
  316. /*
  317.    Neuen Registry Key erzeugen
  318.  
  319. =============================================
  320.  
  321.    Create new key
  322.  
  323. */
  324. METHOD XbpReg:RegCreateKeyEx( cSubKey )
  325.    LOCAL nNewKeyHandle := 0, nDisposition := 0
  326.    ::nCallSuccess := 1  // 1 = no success; 0 = success
  327.  
  328.    If ::nDllHandle = 0
  329.       ::nDllHandle := DllLoad( "ADVAPI32.DLL" )
  330.    EndIF
  331.  
  332.    ::nCallSuccess := DllCall( ::nDllHandle, DLL_STDCALL, "RegCreateKeyExA", ::nHKey,;
  333.                               cSubKey, 0, "", REG_OPTION_NON_VOLATILE, ;
  334.                               KEY_ALL_ACCESS , 0, @nNewKeyHandle, @nDisposition )
  335.  
  336.    If ::nCallSuccess = ERROR_SUCCESS
  337.       ::nKeyHandle := nNewKeyHandle
  338.       ::RegQueryInfoKey()
  339.       ::RegCloseKey()
  340.    EndIF
  341.  
  342. RETURN ::nCallSuccess
  343.  
  344.  
  345. /*
  346.    Neuen Subkey unterhalb des existierenden anlegen
  347.  
  348. ========================================================
  349.  
  350.    Create subkey below existing key
  351.  
  352. */
  353. METHOD XbpReg:NewKey( cSubKey, lKeepOld )
  354.    LOCAL cOldKey := ::KeyName(), lSuccess
  355.  
  356.    DEFAULT cSubKey  TO ""
  357.    DEFAULT lKeepOld TO .T.
  358.  
  359.    If ! EMPTY( cSubkey )
  360.       ::Init( cOldKey + "\" + cSubKey, .T., .T. )
  361.       If ! ::lStatus
  362.          ::Init( cOldKey,,.T. )
  363.       Else
  364.          lSuccess := .T.
  365.          If lKeepOld
  366.             ::Init( cOldKey,,.T. )
  367.          EndIF
  368.       Endif
  369.    EndIF
  370.  
  371. RETURN lSuccess
  372.  
  373. /*
  374.    Subkey unterhalb des existierenden l÷schen
  375.  
  376. ============================================================
  377.  
  378.    Delete subkey (including all contained values and subkeys)
  379.  
  380. */
  381. METHOD XbpReg:DelKey( cSubKey )
  382.    LOCAL lRet := .F.
  383.  
  384.    ::nCallSuccess := 1  // 1 = no success; 0 = success
  385.  
  386.    If ::nDllHandle = 0
  387.       ::nDllHandle := DllLoad( "ADVAPI32.DLL" )
  388.    EndIF
  389.  
  390.    ::RegOpenKeyEx( ::cKey )
  391.    If ::nCallSuccess = ERROR_SUCCESS
  392.       ::nCallSuccess := DllCall( ::nDllHandle, DLL_STDCALL, "RegDeleteKeyA", ::nKeyHandle,;
  393.                                  cSubKey )
  394.  
  395.       lRet := ::nCallSuccess = ERROR_SUCCESS
  396.  
  397.    ENDIF
  398.    ::RegCloseKey()
  399.  
  400. RETURN lRet
  401.  
  402. /*
  403.    Informationen ⁿber Registry Key ermitteln und in den vorgesehenen iVar┤s
  404.    ablegen.
  405.  
  406. ====================================================================================
  407.  
  408.    Gather information about registry key
  409.  
  410. */
  411. METHOD XbpReg:RegQueryInfoKey
  412.    LOCAL lpClass := "", lpcbClass := 0, lpReserved := 0, lpcSubKeys := 0
  413.    LOCAL lpcbMaxSubKeyLen := 0, lpcbMaxClassLen := 0
  414.    LOCAL lpcValues := 0, lpcbMaxValueNameLen := 0, lpcbMaxValueLen := 0
  415.    LOCAL lpcbSecurityDescriptor := 0, lpftLastWriteTime := "        "
  416.  
  417.    ::nCallSuccess := 1  // 1 = no success; 0 = success
  418.  
  419.    If ::nDllHandle = 0
  420.       ::nDllHandle := DllLoad( "ADVAPI32.DLL" )
  421.    EndIF
  422.  
  423.    ::nCallSuccess := DllCall( ::nDllHandle, DLL_STDCALL, "RegQueryInfoKeyA", ::nKeyHandle,;
  424.                               @lpClass,;
  425.                               @lpcbClass,;
  426.                               lpReserved,;
  427.                               @lpcSubKeys,;
  428.                               @lpcbMaxSubKeyLen,;
  429.                               @lpcbMaxClassLen,;
  430.                               @lpcValues,;
  431.                               @lpcbMaxValueNameLen,;
  432.                               @lpcbMaxValueLen,;
  433.                               @lpcbSecurityDescriptor,;
  434.                               @lpftLastWriteTime )
  435.  
  436.    If ::nCallSuccess = ERROR_SUCCESS
  437.       ::cClass              := lpClass
  438.       ::nClass              := lpcbClass
  439.       ::nSubKeys            := lpcSubKeys
  440.       ::nMaxSubKeyLen       := lpcbMaxSubKeyLen
  441.       ::nMaxClassLen        := lpcbMaxClassLen
  442.       ::nValues             := lpcValues
  443.       ::nMaxValueNameLen    := lpcbMaxValueNameLen
  444.       ::nMaxValueLen        := lpcbMaxValueLen
  445.  
  446.       // the following is only valid under WIN/NT
  447.       ::nSecurityDescriptor := lpcbSecurityDescriptor
  448.       ::cLastWriteTime      := lpftLastWriteTime
  449.       ::nLastWriteTime      := Bin2U( SUBSTR( ::cLastWriteTime, 1, 4 ) ) +;
  450.                                  Bin2U( SUBSTR( ::cLastWriteTime, 5, 4 ) ) * 2^32
  451.    EndIF
  452.  
  453. RETURN ::nCallSuccess
  454.  
  455. /*
  456.    Subkeys aus der Registry enumerieren (AufzΣhlen)
  457.    Hilfsmethode, vorher mu▀ der Registry-Key mit ::RegOpenKeyEx ge÷ffnet
  458.    worden sein.
  459.  
  460. =================================================================================
  461.  
  462.    Enumerate subkeys, key has to be opened before with ::RegOpenKeyEX
  463.  
  464. */
  465. METHOD xbpReg:RegEnumKeyEx( nIndex )
  466.    LOCAL cBuffer := SPACE( ::nMaxSubKeyLen + 1 )
  467.    LOCAL nBufLen := ::nMaxSubKeyLen + 1
  468.    LOCAL lpftLastWriteTime := "        "
  469.  
  470.    If ::nDllHandle = 0
  471.       ::nDllHandle := DllLoad( "ADVAPI32.DLL" )
  472.    EndIF
  473.  
  474.    ::nCallSuccess := DllCall( ::nDllHandle, DLL_STDCALL, "RegEnumKeyExA", ::nKeyHandle,;
  475.                               nIndex, @cBuffer, @nBufLen, 0, 0, 0, @lpftLastWriteTime )
  476.  
  477.    If ::nCallSuccess = ERROR_SUCCESS
  478.       ::cLastWriteTime      := lpftLastWriteTime
  479.       ::nLastWriteTime      := Bin2U( SUBSTR( ::cLastWriteTime, 1, 4 ) ) +;
  480.                                  Bin2U( SUBSTR( ::cLastWriteTime, 5, 4 ) ) * 2^32
  481.    EndIF
  482.  
  483. RETURN TRIM(cBuffer)
  484.  
  485. /*
  486.    Values aus der Registry enumerieren (AufzΣhlen)
  487.    Hilfsmethode, vorher mu▀ der Registry-Key mit ::RegOpenKeyEx ge÷ffnet
  488.    worden sein.
  489.  
  490. =================================================================================
  491.  
  492.    Enumerate values, key has to be opened before with ::RegOpenKeyEx
  493.  
  494. */
  495. METHOD xbpReg:RegEnumValue( nIndex, lWithValue )
  496.    LOCAL cBuffer1 := SPACE( ::nMaxValueNameLen + 1 )
  497.    LOCAL nBufLen1 := ::nMaxValueNameLen + 1
  498.    LOCAL cBuffer2 := SPACE( ::nMaxValueLen + 1 )
  499.    LOCAL nBufLen2 := ::nMaxValueLen + 1
  500.    LOCAL nType    := 0
  501.    LOCAL lpftLastWriteTime := "        "
  502.    LOCAL aRet := {}
  503.    LOCAL bError
  504.  
  505.    DEFAULT lWithValue TO .T.
  506.  
  507.    If ::nDllHandle = 0
  508.       ::nDllHandle := DllLoad( "ADVAPI32.DLL" )
  509.    EndIF
  510.  
  511.    ::xValue := NIL
  512.    ::nCallSuccess := DllCall( ::nDllHandle, DLL_STDCALL, "RegEnumValueA", ::nKeyHandle,;
  513.                               nIndex, @cBuffer1, @nBufLen1, 0, @nType, @cBuffer2, @nBufLen2 )
  514.  
  515.    If ::nCallSuccess = ERROR_SUCCESS
  516.       AADD( aRet, TRIM(SUBSTR(cBuffer1,1,nBufLen1)) )
  517.  
  518.       If lWithValue
  519.          DO CASE
  520.             CASE nType == REG_SZ
  521.                ::xValue := SUBSTR( cBuffer2, 1, nBufLen2-1 )
  522.  
  523.             CASE nType == REG_DWORD
  524.                ::xValue := BIN2L( cBuffer2 )
  525.  
  526.             CASE nType == REG_BINARY
  527.                DO CASE
  528.                   CASE ::cReadBinaryTypeAs = "A"
  529.                      ::xValue := Bin2Var( cBuffer2 )
  530.  
  531.                   CASE ::cReadBinaryTypeAs = "C"
  532.                      ::xValue := cBuffer2
  533.  
  534.                   CASE ::cReadBinaryTypeAs = "N"
  535.                      ::xValue := BIN2L( cBuffer2 )
  536.                EndCASE
  537.  
  538.          ENDCASE
  539.       EndIF
  540.  
  541.       AADD( aRet, ::xValue )
  542.  
  543.    ENDIF
  544.  
  545. RETURN aRet
  546.  
  547.  
  548. /*
  549.    Wert aus Registry-Schlⁿssel auslesen
  550.  
  551. ======================================================
  552.  
  553.    Get a named value
  554.  
  555. */
  556. METHOD XbpReg:GetValue( cName )
  557.    LOCAL xRet := SPACE(::nMaxValueLen), nRet := ::nMaxValueLen
  558.    LOCAL nType := 0
  559.    ::nCallSuccess := 1  // 1 = no success; 0 = success
  560.  
  561.    If ::nDllHandle = 0
  562.       ::nDllHandle := DllLoad( "ADVAPI32.DLL" )
  563.    EndIF
  564.  
  565.    ::xValue := NIL
  566.  
  567.    ::RegOpenKeyEx( ::cKey )
  568.    If ::nCallSuccess = ERROR_SUCCESS
  569.  
  570.       ::nCallSuccess := DllCall( ::nDllHandle, DLL_STDCALL, "RegQueryValueExA", ::nKeyHandle,;
  571.                                  @cName, 0, @nType , @xRet, @nRet )
  572.  
  573.       If ::nCallSuccess = ERROR_SUCCESS
  574.          DO CASE
  575.             CASE nType == REG_SZ
  576.                ::xValue := SUBSTR( xRet, 1, nRet-1 )
  577.  
  578.             CASE nType == REG_DWORD
  579.                ::xValue := BIN2L( xRet )
  580.  
  581.             CASE nType == REG_BINARY
  582.                DO CASE
  583.                   CASE ::cReadBinaryTypeAs = "A"
  584.                      ::xValue := Bin2Var( xRet )
  585.  
  586.                   CASE ::cReadBinaryTypeAs = "C"
  587.                      ::xValue := xRet
  588.  
  589.                   CASE ::cReadBinaryTypeAs = "N"
  590.                      ::xValue := BIN2L( xRet )
  591.                EndCASE
  592.          ENDCASE
  593.       Endif
  594.    ENDIF
  595.    ::RegCloseKey()
  596.  
  597. RETURN ::xValue
  598.  
  599. /*
  600.    Wert in Registry-Value ablegen, bzw. Value neu erzeugen
  601.  
  602. ===================================================================
  603.  
  604.    Write/create a named value
  605. */
  606. METHOD XbpReg:SetValue( cName, xValue )
  607.    LOCAL nLen := 0, nType := REG_NONE
  608.  
  609.    ::nCallSuccess := 1  // 1 = no success; 0 = success
  610.  
  611.    If ::nDllHandle = 0
  612.       ::nDllHandle := DllLoad( "ADVAPI32.DLL" )
  613.    EndIF
  614.  
  615.    DO CASE
  616.       CASE VALTYPE( xValue ) = "C"
  617.          nLen  := LEN(xValue) + 1
  618.          nType := REG_SZ
  619.  
  620.       CASE VALTYPE( xValue ) = "N"
  621.          nLen  := 4
  622.          xValue := L2BIN( xValue )
  623.          nType := REG_DWORD
  624.  
  625.       CASE VALTYPE( xValue ) = "A"
  626.          xValue := Var2Bin( xValue )
  627.          nLen   := LEN( xValue )
  628.          nType  := REG_BINARY
  629.  
  630.    ENDCASE
  631.  
  632.    ::RegOpenKeyEx( ::cKey )
  633.    If ::nCallSuccess = ERROR_SUCCESS
  634.       ::nCallSuccess := DllCall( ::nDllHandle, DLL_STDCALL, "RegSetValueExA", ::nKeyHandle,;
  635.                                  @cName, 0, nType , @xValue, nLen )
  636.  
  637.       If ::nCallSuccess = ERROR_SUCCESS
  638.       EndIF
  639.    ENDIF
  640.    ::RegCloseKey()
  641.  
  642. RETURN ::nCallSuccess
  643.  
  644. /*
  645.    Value l÷schen
  646.  
  647. ========================================
  648.  
  649.    Delete value
  650.  
  651. */
  652. METHOD XbpReg:DelValue( cName )
  653.    LOCAL lRet := .F.
  654.  
  655.    ::nCallSuccess := 1  // 1 = no success; 0 = success
  656.  
  657.    If ::nDllHandle = 0
  658.       ::nDllHandle := DllLoad( "ADVAPI32.DLL" )
  659.    EndIF
  660.  
  661.    ::RegOpenKeyEx( ::cKey )
  662.    If ::nCallSuccess = ERROR_SUCCESS
  663.  
  664.       ::nCallSuccess := DllCall( ::nDllHandle, DLL_STDCALL, "RegDeleteValueA", ::nKeyHandle,;
  665.                                  @cName )
  666.  
  667.       lRet :=  ::nCallSuccess = ERROR_SUCCESS
  668.  
  669.    ENDIF
  670.    ::RegCloseKey()
  671.  
  672. RETURN lRet
  673.  
  674.  
  675. /*
  676.    "Standard"-Wert des Registry-Key┤s abfragen oder setzen, als Beispiel siehe
  677.    \HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\TimeZones
  678.  
  679. ==================================================================================
  680.  
  681.    Get/Set "standard" value of the registry key for example see
  682.    \HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\TimeZones
  683.  
  684. */
  685. METHOD XbpReg:Standard( xValue )
  686.  
  687.    If xValue # NIL
  688.       ::SetValue( "", xValue )
  689.    Endif
  690.  
  691. RETURN ::GetValue( "" )
  692.  
  693. /*
  694.    ACCESS/ASSIGN stellt den xBase++ Datentyp ein, der beim Lesen von binären Daten
  695.    aus der Registry verwendet werden soll. Standard ist "A" = Array, d.H.
  696.    Daten mit dem Attribut REG_BINARY werden mit BIN2VAR in ein Array umgewandelt.
  697.  
  698.    (!!! Arrays werden generell mit VAR2BIN gespeichert !!!)
  699. ==================================================================================
  700.  
  701.    ACCESS/ASSIGN to get/set the Xbase++ datatype that should be used when reading
  702.    binary data from the registry. The standard value is "A" so that data with the
  703.    REG_BINARY type attribute gets transferred into an array via BIN2VAR.
  704.  
  705.    (Generally arrays are stored into the registry via VAR2BIN when using ::SetValue()
  706.  
  707. */
  708. METHOD XbpReg:ReadBinType( xValue )
  709.  
  710.    LOCAL cType := ::cReadBinaryTypeAs
  711.  
  712.    If !empty(xValue)
  713.       If VALTYPE(xValue) = "C"
  714.          ::cReadBinaryTypeAs := xValue
  715.       Endif
  716.    Endif
  717.  
  718. RETURN cType
  719.  
  720. /*
  721.    Status des Objekts abfragen
  722.  
  723. ================================================
  724.  
  725.    Get object status
  726.  
  727. */
  728. METHOD XbpReg:Status
  729. RETURN ::lStatus
  730.  
  731.  
  732. /*
  733.    VollstΣndigen Namen des Registry-Keys zurⁿckliefern
  734.  
  735. ====================================================================
  736.  
  737.    Return complete registry key "path"
  738.  
  739. */
  740. METHOD XbpReg:KeyName
  741.    LOCAL cRet := "\"
  742.  
  743.       DO CASE
  744.          CASE ::nHKey = HKEY_LOCAL_MACHINE
  745.             cRet += "HKEY_LOCAL_MACHINE"
  746.  
  747.          CASE ::nHKey = HKEY_CLASSES_ROOT
  748.             cRet += "HKEY_CLASSES_ROOT"
  749.  
  750.          CASE ::nHKey = HKEY_USERS
  751.             cRet += "HKEY_USERS"
  752.  
  753.          CASE ::nHKey = HKEY_CURRENT_USER
  754.             cRet += "HKEY_CURRENT_USER"
  755.  
  756.       ENDCASE
  757.  
  758.       cRet += IIF( ! EMPTY(::cKey), "\" + ::cKey, "" )
  759.  
  760. RETURN cRet
  761.  
  762.  
  763.  
  764. /*
  765.    Liste aller Subkeys als Array zurⁿckgeben
  766.    Verwendet ::RegEnumKeyEx()
  767.  
  768. ==================================================
  769.  
  770.    List all subkeys (returns an array)
  771.    Uses ::RegEnumKeyEx()
  772.  
  773. */
  774. METHOD XbpReg:KeyList
  775.    LOCAL nIndex, aRet := {}, cEnumKey
  776.  
  777.    ::nCallSuccess := 1  // 1 = no success; 0 = success
  778.  
  779.    If ::nDllHandle = 0
  780.       ::nDllHandle := DllLoad( "ADVAPI32.DLL" )
  781.    EndIF
  782.  
  783.    ::RegOpenKeyEx( ::cKey )                // Key ÷ffnen, Fehlercode steht in ::nCallSuccess
  784.    If ::nCallSuccess = ERROR_SUCCESS
  785.  
  786.       nIndex := ::nSubKeys
  787.  
  788.       DO WHILE nIndex >= 0
  789.  
  790.          If ! EMPTY( cEnumKey := ::RegEnumKeyEx( nIndex ) )
  791.             AADD( aRet, cEnumKey )
  792.          EndIF
  793.  
  794.          nIndex--
  795.       EndDO
  796.  
  797.    ENDIF
  798.    ::RegCloseKey()
  799.  
  800.    If LEN( aRet ) # 0
  801.       aRet := ASORT( aRet,,, {|c1,c2| UPPER(c1) < UPPER(c2) } )
  802.    EndIF
  803.  
  804. RETURN aRet
  805.  
  806. /*
  807.    Liste aller Values des Keys als 2-dimensionales Array zurⁿckgeben
  808.    Wird lWithValues auf .F. gesetzt ist das zweite Arrayelement jeweils NIL,
  809.    es werden also nur die ValueNamen, nit jedoch der Wert selbst ermittelt.
  810.    Vorgabewert ist .T. = Werte ermitteln
  811.  
  812.    Verwendet ::RegEnumValue()
  813.  
  814. ==================================================
  815.  
  816.    List all values (returns an 2-dimensional array)
  817.    Set lWithValues to .F. if you only need the value names, not the value itself
  818.    Default is .T.
  819.  
  820.    Uses ::RegEnumValue()
  821.  
  822. */
  823. METHOD XbpReg:ValueList( lWithValues )
  824.    LOCAL nIndex, aRet := {}, aEnumVal
  825.  
  826.    DEFAULT lWithValues TO .T.
  827.  
  828.    ::nCallSuccess := 1  // 1 = no success; 0 = success
  829.  
  830.    If ::nDllHandle = 0
  831.       ::nDllHandle := DllLoad( "ADVAPI32.DLL" )
  832.    EndIF
  833.  
  834.    ::RegOpenKeyEx( ::cKey )                // Key ÷ffnen, Fehlercode steht in ::nCallSuccess
  835.    If ::nCallSuccess = ERROR_SUCCESS
  836.  
  837.       nIndex := ::nValues
  838.       If nIndex # 0
  839.          ::RegEnumValue( 0 )
  840.       EndIF
  841.  
  842.       DO WHILE nIndex >= 0
  843.  
  844.          If LEN( aEnumVal := ::RegEnumValue( nIndex, lWithValues ) ) # 0
  845.             AADD( aRet, aEnumVal )
  846.          EndIF
  847.  
  848.          nIndex--
  849.       EndDO
  850.  
  851.    ENDIF
  852.    ::RegCloseKey()
  853.  
  854.    If LEN( aRet ) # 0
  855.       aRet := ASORT( aRet,,, {|c1,c2| UPPER(c1[1]) < UPPER(c2[1]) } )
  856.    EndIF
  857.  
  858. RETURN aRet
  859.  
  860. /*
  861.    Eine Ebene h÷her in der Schlⁿsselhierarchie
  862.    (Σhnlich dem DOS-Kommando CD..)
  863.  
  864. =====================================================
  865.  
  866.    Move one level up in the key hierarchy
  867.    (similar to the dos command CD..)
  868.  
  869. */
  870. METHOD xbpReg:MoveUp
  871.    LOCAL cNewKey, nPos, lSuccess := .F.
  872.  
  873.    nPos := RAT( "\", ::KeyName() )
  874.  
  875.    If nPos > 1
  876.       cNewKey := LEFT( ::KeyName, nPos-1)
  877.       ::Init( cNewKey,,.T. )
  878.       lSuccess := ::lStatus
  879.    EndIF
  880.  
  881. RETURN lSuccess
  882.  
  883. /*
  884.    Eine Ebene tiefer in der Schlⁿsselhierarchie
  885.  
  886. ===========================================================
  887.  
  888.    Move down one level
  889.  
  890. */
  891. METHOD xbpReg:MoveDown( cSubkey )
  892.    LOCAL cOldKey := ::KeyName(), lSuccess := .F.
  893.  
  894.    DEFAULT cSubKey TO ""
  895.    If ! EMPTY( cSubkey )
  896.       ::Init( cOldKey + "\" + cSubKey,,.T. )
  897.       If ! ::lStatus
  898.          ::Init( cOldKey,,.T. )
  899.       Else
  900.          lSuccess := .T.
  901.       Endif
  902.    EndIF
  903.  
  904. RETURN lSuccess